home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / alphaHooks.tcl < prev    next >
Encoding:
Text File  |  1999-01-06  |  22.7 KB  |  724 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "alphaHooks.tcl"
  6.  #                                    created: 18/7/97 {5:10:18 pm} 
  7.  #                                last update: 6/1/1999 {1:06:08 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1998  Vince Darley, all rights reserved
  15.  #  
  16.  # Description: 
  17.  #  
  18.  #  Here are the current hooks:
  19.  #  
  20.  #  activateHook changeMode closeHook deactivateHook modifyModeFlags 
  21.  #  quitHook resumeHook saveasHook saveHook savePostHook suspendHook
  22.  #  openHook
  23.  #  
  24.  #  There's also a 'mode::init' hook which will be called the first
  25.  #  time a mode is started up.  Note that the mode exists, but its
  26.  #  variables have not yet been made global, and its menus have not
  27.  #  yet been inserted into the menu bar.
  28.  #  
  29.  #  There's also a 'startupHook' which is called when Alpha starts
  30.  #  up, but after all other initialisation has taken place (before
  31.  #  any files are opened though).
  32.  #  
  33.  #  There's also a 'launch' hook for when an app is launched.
  34.  #  
  35.  #  Use of such lists as 'savePostHooks' is obsolete.
  36.  #  These lists are ignored, use hook::register instead.
  37.  #  
  38.  #  History
  39.  # 
  40.  #  modified by  rev reason
  41.  #  -------- --- --- -----------
  42.  #  18/7/97  VMD 1.0 original
  43.  #  22/7/97  VMD 1.1 fixed all bugs ;-) and added the above examples.
  44.  # ###################################################################
  45.  ##
  46.  
  47. namespace eval mode {}
  48. namespace eval win {}
  49.  
  50. lappend mode::procs carriageReturn OptionTitleBar OptionTitleBarSelect \
  51.   electricLeft electricRight electricSemi indentLine indentRegion \
  52.   parseFuncs MarkFile
  53.  
  54. proc saveHook name {
  55.     global backup backupExtension backupFolder mode win::Modes \
  56.       backupAgeRequirementInHours modifiedVars
  57.     hook::callAll saveHook [set win::Modes($name)] $name
  58.     if {$backup} {
  59.     if {$backupFolder != "" && ![file exists $backupFolder]} {
  60.         if {![dialog::yesno "Create backup folder '$backupFolder'?"]} {
  61.         alertnote "Backup saved in document's folder."
  62.         set backupFolder ""
  63.         lappend modifiedVars backupFolder
  64.         } elseif {[catch {file::ensureDirExists $backupFolder}]} {
  65.         alertnote "Couldn't create backup folder. Backup saved in document's folder."
  66.         set backupFolder ""
  67.         lappend modifiedVars backupFolder
  68.         }
  69.     }
  70.     set dir $backupFolder
  71.  
  72.     if {![string length $dir]} {
  73.         set dir [file dirname $name]
  74.     }
  75.     if {$backupExtension == "" && $backupFolder == ""} {
  76.         set backupExtension ~
  77.         lappend modifiedVars backupExtension
  78.     }
  79.     set backfile [file join $dir [file tail $name]$backupExtension]
  80.     if {$backupExtension == "" && [file dirname $name] == $backupFolder} {
  81.         append backfile ~
  82.     }
  83.     if {[file exists $backfile]} {
  84.         getFileInfo $name a
  85.         if {[expr {([now] - $a(modified) + 0.0)/3600}] < $backupAgeRequirementInHours} {
  86.         return
  87.         }
  88.         catch {file delete $backfile}
  89.     }
  90.     message "Backing up $backfile"
  91.     catch {file copy $name $backfile}
  92.     }
  93. }
  94.  
  95. proc saveUnmodified {} {
  96.     set name [win::Current]
  97.     if {[file exists $name] || \
  98.       ([regsub { <\w+>$} $name {} name] && [file exists $name])} {
  99.     getFileInfo $name arr
  100.     set mod $arr(modified)
  101.     save
  102.     setFileInfo $name modified $mod
  103.     return
  104.     }
  105.     # shouldn't really get here!
  106.     error "File doesn't exist"
  107. }
  108.  
  109. ## 
  110.  # -------------------------------------------------------------------------
  111.  # 
  112.  # "changeMode" --
  113.  # 
  114.  #  A very important procedure.  It handles all switching from one mode
  115.  #  to another.  This means it has to adjust menus, floating windows,
  116.  #  global variables, mode prefs, and call a number of hooks.
  117.  #  
  118.  #  It maintains a list of variables which the new mode over-rides from
  119.  #  the global scope, and recreates them.  This allows a mode to have
  120.  #  its own value for a global variable without messing anything up.
  121.  # -------------------------------------------------------------------------
  122.  ##
  123. proc changeMode {newMode} {
  124.     global lastMode dummyProc mode seenMode PREFS
  125.     global global::_vars mode::features global::features
  126.     
  127.     set lastMode $mode
  128.     set mode $newMode
  129.     if {$lastMode == $mode} {
  130.         if {$newMode != ""} {
  131.         displayMode $newMode
  132.     }
  133.         return
  134.     }
  135.     if {$lastMode == ""} {
  136.     renameMenuItem -m Config "Mode Prefs" "${mode} Mode Prefs"
  137.     catch {menuEnableHook 1}
  138.     } elseif {$mode == ""} {
  139.     renameMenuItem -m Config "${lastMode} Mode Prefs" "Mode Prefs"
  140.     catch {menuEnableHook 0}
  141.     } else {
  142.     renameMenuItem -m Config "${lastMode} Mode Prefs" "${mode} Mode Prefs"
  143.     }
  144.     
  145.     global ${lastMode}modeVars
  146.     if {[info exists ${lastMode}modeVars]} {
  147.         foreach v [array names ${lastMode}modeVars] {
  148.             global $v
  149.             catch {unset $v}
  150.         }
  151.     }
  152.     floatShowHide off $lastMode
  153.     if {[info exists global::_vars]} { 
  154.     uplevel \#0 ${global::_vars}
  155.     unset global::_vars
  156.     }
  157.     if {[info exists mode::features($mode)]} {
  158.     set onoff [package::onOrOff [set mode::features($mode)] $lastMode]
  159.     } else {
  160.     set onoff [package::onOrOff "" $lastMode]
  161.     }
  162.     
  163.     foreach m [lindex $onoff 0] {
  164.     package::deactivate $m
  165.     }
  166.     
  167.     # These lines must load the mode vars into the mode var scope.
  168.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  169.     if {![info exists seenMode($mode)]} {
  170.     hook::callAll mode::init $mode
  171.     }
  172.     # once the vars are in mode-var scope (= the <mode>modeVars array),
  173.     # they can be transfered to the global scope.  A future version of
  174.     # Alpha with Tcl8.0 namespaces may not need to do this.
  175.     global ${mode}modeVars
  176.     if {[info exists ${mode}modeVars]} {
  177.         foreach v [array names ${mode}modeVars] {
  178.             global $v
  179.         if {[info exists $v]} { append global::_vars "set $v \{[set $v]\} ;" }
  180.             set $v [set ${mode}modeVars($v)]
  181.         }
  182.     }
  183.     foreach m [lindex $onoff 1] {
  184.     package::activate $m
  185.     }
  186.     
  187.     floatShowHide on $mode
  188.  
  189.     if {![info exists seenMode($mode)]} {
  190.     global mode::procs
  191.     #foreach p ${mode::procs} {
  192.     #    if {[info commands ${mode}::${p}] == ""} {
  193.     #    auto_load ${mode}::${p}
  194.     #    }
  195.     #}
  196.     set seenMode($mode) 1
  197.     if {($mode != "") && [file exists [file join $PREFS ${mode}Prefs.tcl]]} {
  198.         if {[catch {uplevel \#0 [list source [file join $PREFS ${mode}Prefs.tcl]]}]} {
  199.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  200.             } 
  201.         }
  202.     }
  203.         
  204.     if {$newMode != ""} {
  205.     displayMode $newMode
  206.     }
  207.  
  208.     hook::callAll changeMode $mode $mode
  209. }
  210.  
  211. ## 
  212.  # -------------------------------------------------------------------------
  213.  # 
  214.  # "requireOpenWindowsHook" --
  215.  # 
  216.  #  En-/disable meaningless menu items which would require the presence
  217.  #  of a certain number of windows to be active
  218.  #  
  219.  #  This proc should only be called from 'openHook' and 'closeHook'.
  220.  #  
  221.  #  You can register with it using 
  222.  #  
  223.  #  'hook::register requireOpenWindowsHook [list menu item] N'
  224.  #  
  225.  #  where 'N' is the number of windows required (1 or 2 usually)
  226.  #  (and deregister etc using hook::deregister).
  227.  #  
  228.  #  We only really need the catch in here for two reasons:
  229.  #  (i) in case bad menus are registered accidentally
  230.  #  (ii) so startup errors can open a window without hitting another error
  231.  #  in the middle of doing that!
  232.  # -------------------------------------------------------------------------
  233.  ##
  234. proc requireOpenWindowsHook {requiredNum} {
  235.     foreach count $requiredNum {
  236.     set enable [expr {[llength [winNames]] >= $requiredNum ? 1 : 0}]
  237.     foreach i [hook::list requireOpenWindowsHook $requiredNum] {
  238.         catch "enableMenuItem $i $enable"
  239.     }
  240.     }
  241. }
  242.  
  243. ## 
  244.  # -------------------------------------------------------------------------
  245.  # 
  246.  # "menuEnableHook" --
  247.  # 
  248.  #  This hook is called to turn menu items on or off.  It is called 
  249.  #  whenever there are no windows, or when we go from 0->1 window.
  250.  #  
  251.  #  It should deal with all standard menus.  It does not deal with
  252.  #  special menu items like 'save', 'revert',.. which require more
  253.  #  information.
  254.  #  
  255.  #  It is called from changeMode.
  256.  #  
  257.  #  Andreas wrote most of this proc.
  258.  #  
  259.  #  Due to a deficiency in MacOS/MercutioMDEF/Alpha (not sure who
  260.  #  the culprit is!), key-bindings attached to menu items are still
  261.  #  triggered even if the menu item is inactive.
  262.  # -------------------------------------------------------------------------
  263.  ##
  264. proc menuEnableHook {{haveWin 1}} {
  265.     global winMenu mode
  266.     # we only get here if there are no windows, or 1 window which we
  267.     # just opened.  Otherwise nothing will be different to last time.
  268.     enableMenuItem File close $haveWin
  269.     enableMenuItem File closeAll $haveWin
  270.     enableMenuItem File closeFloat $haveWin
  271.     enableMenuItem File saveAs… $haveWin
  272.     enableMenuItem File saveACopyAs… $haveWin
  273.     if {[package::active printerChoicesMenu]} {
  274.     enableMenuItem File print $haveWin
  275.     } else {
  276.     enableMenuItem File print… $haveWin
  277.     }
  278.     enableMenuItem File printAll $haveWin
  279.     eval [lindex [list un {}] $haveWin]Bind 'p' <c> print
  280.     
  281.     enableMenuItem Edit undo $haveWin
  282.     enableMenuItem Edit redo $haveWin
  283.     enableMenuItem Edit evaluate $haveWin
  284.     enableMenuItem Edit cut $haveWin
  285.     enableMenuItem Edit cut&Append $haveWin
  286.     enableMenuItem Edit copy $haveWin
  287.     enableMenuItem Edit copy&Append $haveWin
  288.     enableMenuItem Edit paste $haveWin
  289.     enableMenuItem Edit pastePop $haveWin
  290.     enableMenuItem Edit selectAll $haveWin
  291.     enableMenuItem Edit selectParagraph $haveWin
  292.     enableMenuItem Edit clear $haveWin
  293.     enableMenuItem Edit twiddle $haveWin
  294.     enableMenuItem Edit twiddleWords $haveWin
  295.     enableMenuItem Edit shiftLeft  $haveWin
  296.     enableMenuItem Edit shiftLeftSpace  $haveWin
  297.     enableMenuItem Edit shiftRight  $haveWin
  298.     enableMenuItem Edit shiftRightSpace  $haveWin
  299.     enableMenuItem Edit balance  $haveWin
  300.     enableMenuItem Edit emacs $haveWin
  301.  
  302.     if {[info tclversion] < 8.0} {
  303.         enableMenuItem Text fillParagraph $haveWin
  304.         enableMenuItem Text wrapParagraph $haveWin
  305.         enableMenuItem Text sentenceParagraph $haveWin
  306.         enableMenuItem Text fillRegion $haveWin
  307.         enableMenuItem Text wrapRegion $haveWin
  308.         enableMenuItem Text sentenceRegion $haveWin
  309.         enableMenuItem Text paragraphToLine $haveWin
  310.         enableMenuItem Text lineToParagraph $haveWin
  311.         enableMenuItem Text reverseSort $haveWin
  312.         enableMenuItem Text sortLines $haveWin
  313.         enableMenuItem Text sortParagraphs $haveWin
  314.         enableMenuItem Text zapInvisibles $haveWin
  315.         enableMenuItem Text tabsToSpaces $haveWin
  316.         enableMenuItem Text spacesToTabs $haveWin
  317.         enableMenuItem Text indentLine $haveWin
  318.         enableMenuItem Text indentSelection $haveWin
  319.         enableMenuItem Text upcaseRegion $haveWin
  320.         enableMenuItem Text downcaseRegion $haveWin
  321.         enableMenuItem Text strings $haveWin
  322.         enableMenuItem Text commentLine $haveWin
  323.         enableMenuItem Text uncommentLine $haveWin
  324.         enableMenuItem Text commentBox $haveWin
  325.         enableMenuItem Text uncommentBox $haveWin
  326.         enableMenuItem Text commentParagraph $haveWin
  327.         enableMenuItem Text uncommentParagraph $haveWin
  328.     enableMenuItem Config "Mode Prefs" $haveWin
  329.     } else {
  330.     enableMenuItem Text "" $haveWin
  331.     if {$mode == ""} {
  332.         enableMenuItem -m Config "Mode Prefs" $haveWin
  333.     } else {
  334.         enableMenuItem -m Config "${mode} Mode Prefs" $haveWin
  335.     }
  336.     }
  337.     
  338.     enableMenuItem Search searchStart $haveWin
  339.     enableMenuItem Search findAgain $haveWin
  340.     enableMenuItem Search findAgainBackward $haveWin
  341.     if { ![string compare [searchString] ""] && !$haveWin } {
  342.     enableMenuItem Search findInNextFile $haveWin
  343.     } else {
  344.     enableMenuItem Search findInNextFile 1
  345.     }
  346.     enableMenuItem Search enterSearchString $haveWin
  347.     enableMenuItem Search enterReplaceString $haveWin
  348.     enableMenuItem Search quickFind $haveWin
  349.     enableMenuItem Search quickFindRegexp $haveWin
  350.     enableMenuItem Search reverseQuickFind $haveWin
  351.     enableMenuItem Search replace $haveWin
  352.     enableMenuItem Search replace&FindAgain $haveWin
  353.     enableMenuItem Search replaceAll $haveWin
  354.     enableMenuItem Search placeBookmark $haveWin
  355.     enableMenuItem Search returnToBookmark $haveWin
  356.     enableMenuItem Search gotoLine $haveWin
  357.     enableMenuItem Search matchingLines $haveWin
  358.     enableMenuItem Search gotoMatch $haveWin
  359.     enableMenuItem Search nextMatch $haveWin
  360.     enableMenuItem Search gotoFunc $haveWin
  361.     # These four don't work because of a bug in Alpha.
  362.     # It won't recognise items near the end of long menus
  363.     # (long is > 20 items or so).  We leave them in hoping
  364.     # for the future...
  365.     enableMenuItem Search gotoFileMark $haveWin
  366.     enableMenuItem Search markHilite $haveWin
  367.     enableMenuItem Search namedMarks $haveWin
  368.     enableMenuItem Search unnamedMarks $haveWin
  369.     
  370.     enableMenuItem Utils AsciiEtc $haveWin
  371.     enableMenuItem Utils cmdDoubleClick $haveWin
  372.     enableMenuItem Utils winUtils $haveWin
  373.     enableMenuItem Utils spellcheckWindow $haveWin
  374.     enableMenuItem Utils spellcheckSelection $haveWin
  375.     enableMenuItem Utils wordCount $haveWin
  376.     
  377.     enableMenuItem Config setFontsTabs… $haveWin
  378.     
  379.     enableMenuItem $winMenu zoom $haveWin
  380.     enableMenuItem $winMenu singlePage $haveWin
  381.     enableMenuItem $winMenu chooseAWindow $haveWin
  382.     enableMenuItem $winMenu iconify $haveWin
  383.     enableMenuItem $winMenu arrange $haveWin
  384.     enableMenuItem $winMenu splitWindow $haveWin
  385.     enableMenuItem $winMenu toggleScrollbar $haveWin
  386.     
  387.     if {!$haveWin} {
  388.     enableMenuItem File save 0
  389.     enableMenuItem File saveUnmodified 0
  390.     enableMenuItem File revert 0
  391.     enableMenuItem File revertToBackup 0
  392.     enableMenuItem File renameTo… 0
  393.     enableMenuItem File saveAll 0
  394.     }
  395.     
  396.     requireOpenWindowsHook 1
  397. }
  398.  
  399. proc savePostHook name {
  400.     hook::callAll savePostHook "" $name
  401. }
  402.  
  403. proc closeHook name {
  404.     global markStack win::Modes win::Active win::Current win::Dirty win::NumDirty
  405.     hook::callAll closeHook [set win::Modes($name)] $name
  406.  
  407.     if {[info exists win::Dirty($name)]} {
  408.     incr win::NumDirty -1
  409.     unset win::Dirty($name)
  410.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  411.     }
  412.         
  413.     unset win::Modes($name)
  414.     if {[llength $markStack]} {
  415.         set markStack [lremove -glob $markStack $name*]
  416.     }
  417.     win::removeFromMenu $name
  418.  
  419.     if {[set ind [lsearch -exact ${win::Active} $name]] >= 0} {
  420.         set win::Active [lreplace ${win::Active} $ind $ind]
  421.     }
  422.     if {![llength [winNames]]} {
  423.     set win::Current ""
  424.     changeMode {}
  425.     }
  426.     requireOpenWindowsHook 2
  427. }
  428.  
  429. proc deactivateHook name {
  430.     hook::callAll deactivateHook "" $name
  431. }
  432.  
  433. proc suspendHook name {
  434.     hook::callAll suspendHook "" $name
  435.     global iconifyOnSwitch
  436.     global suspIconed
  437.     if {$iconifyOnSwitch} {
  438.         set wins [winNames -f]
  439.         set suspIconed ""
  440.         foreach win $wins {
  441.             if {![icon -f "$win" -q]} {
  442.                 lappend suspIconed $win
  443.                 icon -f "$win" -t
  444.             }
  445.         }
  446.         set suspIconed [lreverse $suspIconed]
  447.     }
  448. }
  449.  
  450. ensureset killCompilerErrors 0
  451. proc resumeHook name {
  452.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  453.     
  454.     if {$killCompilerErrors} {
  455.     set wins [winNames -f]
  456.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  457.         bringToFront [lindex $wins $res]
  458.         killWindow
  459.     }
  460.     }
  461.     
  462.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  463.     set wins [winNames -f]
  464.     foreach win $suspIconed {
  465.         icon -f "$win" -o
  466.     }
  467.     unset suspIconed
  468.     }
  469.     if {$resumeRevert} {
  470.     set resumeRevert 0
  471.     revert
  472.     }
  473.     hook::callAll resumeHook "" $name
  474. }
  475.  
  476. ## 
  477.  # -------------------------------------------------------------------------
  478.  # 
  479.  # "saveasHook" --
  480.  # 
  481.  #  Called when saving a window which doesn't yet exist as a file
  482.  #  (in particular 'Untitled' windows) or when the user selects
  483.  #  saveAs.
  484.  # -------------------------------------------------------------------------
  485.  ##
  486. proc saveasHook {oldName newName} {
  487.     global win::Modes win::Active win::Current
  488.     if {$oldName == $newName} return
  489.     win::removeFromMenu $oldName
  490.     win::addToMenu $newName
  491.     win::setMode $newName
  492.     changeMode [set win::Modes($newName)]
  493.     
  494.     if {[set ind [lsearch -exact ${win::Active} $oldName]] >= 0} {
  495.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $newName]
  496.     } else {
  497.     # hmmm! this is bad.  The old window has gone!
  498.     set win::Active [linsert ${win::Active} 0 $newName]
  499.     }
  500.     
  501.     set win::Current $newName
  502.     catch {unset win::Modes($oldName)}
  503.     hook::callAll saveasHook [set win::Modes($newName)] $oldName $newName
  504.     refresh
  505. }
  506.  
  507. ## 
  508.  # -------------------------------------------------------------------------
  509.  # 
  510.  # "saveACopyAs" --
  511.  # 
  512.  # Finally a proc to add to your collection of Alpha bugs.
  513.  # copyFile has an interesting bug. If the destination file exists it
  514.  # puts the file in [pwd] instead. This proc makes sure it is removed first.
  515.  #  
  516.  # (This proc actually has nothing to do with hooks, but seemed to fit here)
  517.  # -------------------------------------------------------------------------
  518.  ##
  519. proc saveACopyAs {} {
  520.     if {[file exists [set nm [stripNameCount [win::Current]]]]} {
  521.     set nm2 [putfile "Save a copy as:" [file tail $nm]]
  522.     if {[file exists $nm2]} {file delete $nm2}
  523.     file copy $nm $nm2
  524.     }
  525. }
  526.  
  527.  
  528. ensureset win::Active ""
  529.  
  530. proc activateHook {name} {
  531.     global win::Modes win::Active win::Current
  532.     
  533.     if {![info exists win::Modes($name)]} {
  534.     win::setMode $name
  535.     }
  536.     if {[set ind [lsearch -exact ${win::Active} $name]] == -1} {
  537.     set win::Active [linsert ${win::Active} 0 $name]
  538.     } elseif {$ind >= 1} {
  539.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $name]
  540.     }
  541.     set win::Current $name
  542.     
  543.     changeMode [set win::Modes($name)]
  544.     
  545.     hook::callAll activateHook [set win::Modes($name)] $name
  546.     
  547.     # if the file exists (this seems to be the quickest way to check)
  548.     if {[file exists $name] || \
  549.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm])} {
  550.     # this fails if the window is just opening, but then we know it's clean
  551.     if {[catch {getWinInfo -w $name arr}]} {
  552.         set dirty 0
  553.     } else {
  554.         set dirty $arr(dirty)
  555.     }
  556.     enableMenuItem File save $dirty
  557.     enableMenuItem File saveUnmodified $dirty
  558.     enableMenuItem File revert $dirty
  559.     enableMenuItem File revertToBackup 1
  560.     enableMenuItem File renameTo… 1
  561.     enableMenuItem Edit undo $dirty
  562.     } else {
  563.     enableMenuItem File save 0
  564.     enableMenuItem File saveUnmodified 0
  565.     enableMenuItem File revert 0
  566.     enableMenuItem File revertToBackup 0
  567.     enableMenuItem File renameTo… 0
  568.     enableMenuItem Edit undo 0
  569.     }
  570.     
  571. }
  572.  
  573. proc quitHook {} {
  574.     global PREFS alpha::tracingChannel
  575.     if {[file exists [file join $PREFS ftpTmp]]} {
  576.         catch {rm [file join $PREFS ftpTmp *]}
  577.     }
  578.     catch {close ${alpha::tracingChannel}}
  579.     saveModifiedVars
  580.     hook::callAll quitHook
  581. }
  582.  
  583. ## 
  584.  # -------------------------------------------------------------------------
  585.  # 
  586.  # "dirtyHook" --
  587.  # 
  588.  #  This proc currently has to keep track in the array 'win::Dirty' of
  589.  #  the dirty status of windows.  Its only use is if we close a dirty
  590.  #  window and select 'discard', we would otherwise have a faulty
  591.  #  'win::NumDirty' count.  If there's a different solution we should
  592.  #  get rid of the win::Dirty array.
  593.  #  
  594.  #  Note: closeHook is called after the window is gone, and killWindow
  595.  #  isn't called if you click in the close-box, so they don't solve
  596.  #  the problem.
  597.  # -------------------------------------------------------------------------
  598.  ##
  599. proc dirtyHook {name dirty} {
  600.     global winMenu win::NumDirty win::Dirty
  601.     markMenuItem -m $winMenu [file tail $name] $dirty "◊"
  602.     if {$dirty == "on" || $dirty == 1} {
  603.     set win::Dirty($name) 1
  604.     incr win::NumDirty 1
  605.     } else {
  606.     catch {unset win::Dirty($name)}
  607.     incr win::NumDirty -1
  608.     }
  609.     enableMenuItem File save $dirty
  610.     enableMenuItem File saveUnmodified $dirty
  611.     enableMenuItem File revert $dirty
  612.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  613.     # we may still revertToBackup even if the file is clean.
  614.     # however we can't just revert.
  615.     enableMenuItem Edit undo $dirty
  616. }
  617.  
  618. proc openHook name {
  619.     global win::Modes autoMark mode screenHeight screenWidth \
  620.       forceMainScreen
  621.  
  622.     changeMode [set win::Modes($name)]
  623.     regsub -all {\\([][])} $name {\1} nm
  624.     win::addToMenu $nm
  625.     message ""
  626.  
  627.     if {[file exists $name] && (![catch {getFileInfo $name info}])} {
  628.         if {[info exists info(creator)] && ($info(creator) == {ttxt})} {
  629.             setWinInfo dirty 0
  630.         }
  631.         if {[info exists info(type)] && ($info(type) == {ttro})} {
  632.             catch {setWinInfo read-only 1}
  633.             message "Read-only!"
  634.         }
  635.     }
  636.  
  637.     global ${mode}modeVars
  638.     
  639.     if {$forceMainScreen} {
  640.         set geo [getGeometry]
  641.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  642.         if {($l < 0) || ($t < 35) || ([expr {$l + $w}] > $screenWidth) || ([expr {$t + $h + 18}] > $screenHeight)} {
  643.             singlePage
  644.         }
  645.     }
  646.     getWinInfo arr
  647.     if {!$arr(read-only)} {
  648.     if {[info exists ${mode}modeVars(autoMark)] \
  649.       && [set ${mode}modeVars(autoMark)] \
  650.       && ![llength [getNamedMarks -n]]} {
  651.         markFile
  652.     }
  653.     }
  654.     if {[regexp {\(tabsize:([0-9]+)\)} \
  655.       [getText [minPos] [nextLineStart [minPos]]] "" tabs]} {
  656.     setWinInfo tabsize $tabs
  657.     }
  658.     global PREFS
  659.     if {[string match "${PREFS}*defs.tcl" $name]} {setWinInfo read-only 1}
  660.     
  661.     requireOpenWindowsHook 2
  662.     
  663.     hook::callAll openHook [set win::Modes($name)] $name
  664. }
  665.  
  666. ## 
  667.  # -------------------------------------------------------------------------
  668.  # 
  669.  # "fileMovedHook" --
  670.  # 
  671.  #  Called by Alpha when a window's file has been moved behind our back.
  672.  #  (Only for Alpha using Tcl 8.0)
  673.  # -------------------------------------------------------------------------
  674.  ##
  675. proc fileMovedHook {from to} {
  676.     global win::Active winNumToName winNameToNum
  677.     if {[info exists winNameToNum($from)]} {
  678.     set i $winNameToNum($from)
  679.     unset winNameToNum($from)
  680.     set winNumToName($i) $to
  681.     set winNameToNum($to) $i
  682.     } else {
  683.     alertnote "Can't find old window.  Bad error."
  684.     }
  685.     set idx [lsearch -exact ${win::Active} $from]
  686.     if {$idx >= 0} {
  687.     set win::Active [lreplace ${win::Active} $idx $idx $to]
  688.     } else {
  689.     alertnote "Can't find the old window! Bad error in fileMovedHook."
  690.     }
  691.     hook::callAll fileMovedHook $from $to
  692. }
  693.  
  694.  
  695. proc revertToBackup {} {
  696.     global backup backupExtension backupFolder win::Modes
  697.  
  698.     set fname [stripNameCount [win::Current]]
  699.     set dir $backupFolder
  700.     if {$dir == ""} {
  701.         set dir [file dirname $fname]
  702.     }
  703.     set bname [file join $dir "[file tail $fname]$backupExtension"]
  704.     if {![file exists $bname]} {
  705.         beep
  706.         message "Backup file '$bname' does not exist"
  707.         return
  708.     }
  709.  
  710.     if {[dialog::yesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"]} {
  711.         killWindow
  712.  
  713.         edit $bname
  714.         saveAs -f $fname
  715.     }
  716. }
  717.  
  718.  
  719.  
  720.  
  721.  
  722.  
  723.  
  724.